perm filename FLIPS.SAI[4,ALS] blob sn#056498 filedate 1973-08-02 generic text, type T, neo UTF8
00010	BEGIN "FLIPS"
00020	INTEGER I,J,K,L,M,N,P,Q,POINTX,STATE,DELTA,VAL,CHAN1,EOF;
00030	INTEGER ARRAY BUF,FLOPS[0:1000];
00040	STRING FILEN,READ;
00050	DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00060	
00070	FILEN←"FLTD.001[DAT,NJM]";
00080	OUTSTR("Type file name (CR for "&FILEN&".");
00090	IF (READ←INCHWL)≠"" THEN FILEN←READ;
00100	OUTSTR("Specify DELTA (CR for 5) ");
00110	IF (READ←INCHWL)="" THEN DELTA←5 ELSE DELTA←CVD(READ);
00120	CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00130	LOOKUP(CHAN1,FILEN,0);
00140	J←K←L←STATE←VAL←0;
00160	OUTSTR(CRLF&"Frication measure on file "&FILEN
00170	   &" with DELTA set at "&CVS(DELTA)&CRLF&LF&TB);
00180	SETFORMAT(6,0);
00185	FOR I←0 STEP 1 UNTIL 9 DO OUTSTR(CVS(I)); OUTSTR(CRLF&LF);
00187	Q←0; OUTSTR(CVS(Q)&TB);
00190	WHILE TRUE DO BEGIN
00200	  IF EOF≠0 THEN DONE;
00210	  FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
00220	  ARRYIN(CHAN1,BUF[0],1000);
00230	  POINTX←POINT(12,BUF[0],-1);
00240	FOR I←0 STEP 1 UNTIL 9 DO BEGIN
00250	  FOR J←0 STEP 1 UNTIL 99 DO BEGIN
00260	    VAL←ILDB(POINTX);
00270	    IF STATE=0 THEN
00280	      IF VAL>K-DELTA THEN L←L+1 ELSE BEGIN
00290	      M←(M*15+L) LSH -4;L←0; STATE←-1; END ELSE
00300	
00310	      IF VAL<K+DELTA THEN L←L+1 ELSE BEGIN
00320	      M←(M*15+L) LSH -4; L←0; STATE←0; END;
00330	    K←L;
00340	    END;
00350	IF M≤15 THEN FLOPS[I]←M ELSE FLOPS[I]←15;
00360	  OUTSTR(CVS(M)); IF (P MOD 10)=9 THEN BEGIN Q←Q+10;
00370	  OUTSTR(CRLF&CVS(Q)&TB); P←0; END ELSE P←P+1;
00380	  END;
00390	END;
00400	
00410	END "FLIPS";